home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / sptmbr16.lha / fsc.lisp < prev    next >
Text File  |  1992-12-21  |  4KB  |  101 lines
  1. ;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*-
  2. ;;;
  3. ;;; *************************************************************************
  4. ;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
  5. ;;; All rights reserved.
  6. ;;;
  7. ;;; Use and copying of this software and preparation of derivative works
  8. ;;; based upon this software are permitted.  Any distribution of this
  9. ;;; software or derivative works must comply with all applicable United
  10. ;;; States export control laws.
  11. ;;; 
  12. ;;; This software is made available AS IS, and Xerox Corporation makes no
  13. ;;; warranty about the software, its performance or its conformity to any
  14. ;;; specification.
  15. ;;; 
  16. ;;; Any person obtaining a copy of this software is requested to send their
  17. ;;; name and post office or electronic mail address to:
  18. ;;;   CommonLoops Coordinator
  19. ;;;   Xerox PARC
  20. ;;;   3333 Coyote Hill Rd.
  21. ;;;   Palo Alto, CA 94304
  22. ;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
  23. ;;;
  24. ;;; Suggestions, comments and requests for improvements are also welcome.
  25. ;;; *************************************************************************
  26. ;;;
  27. ;;; This file contains the definition of the FUNCALLABLE-STANDARD-CLASS
  28. ;;; metaclass.  Much of the implementation of this metaclass is actually
  29. ;;; defined on the class STD-CLASS.  What appears in this file is a modest
  30. ;;; number of simple methods related to the low-level differences in the
  31. ;;; implementation of standard and funcallable-standard instances.
  32. ;;;
  33. ;;; As it happens, none of these differences are the ones reflected in
  34. ;;; the MOP specification; STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS
  35. ;;; share all their specified methods at STD-CLASS.
  36. ;;; 
  37. ;;; 
  38. ;;; workings of this metaclass and the standard-class metaclass.
  39. ;;; 
  40.  
  41. (in-package :pcl)
  42.  
  43. (defmethod wrapper-fetcher ((class funcallable-standard-class))
  44.   'fsc-instance-wrapper)
  45.  
  46. (defmethod slots-fetcher ((class funcallable-standard-class))
  47.   'fsc-instance-slots)
  48.  
  49. (defmethod raw-instance-allocator ((class funcallable-standard-class))
  50.   'allocate-funcallable-instance)
  51.  
  52. ;;;
  53. ;;;
  54. ;;;
  55.  
  56. (defmethod validate-superclass
  57.        ((fsc funcallable-standard-class)
  58.         (class standard-class))
  59.   t) ; was (null (wrapper-instance-slots-layout (class-wrapper class)))
  60.  
  61.  
  62. (defmethod allocate-instance
  63.        ((class funcallable-standard-class) &rest initargs)
  64.   (declare (ignore initargs))
  65.   (unless (class-finalized-p class) (finalize-inheritance class))
  66.   (allocate-funcallable-instance (class-wrapper class)))
  67.  
  68. (defmethod make-reader-method-function ((class funcallable-standard-class)
  69.                     slot-name)
  70.   (make-std-reader-method-function (class-name class) slot-name))
  71.  
  72. (defmethod make-writer-method-function ((class funcallable-standard-class)
  73.                     slot-name)
  74.   (make-std-writer-method-function (class-name class) slot-name))
  75.  
  76. ;;;;
  77. ;;;; See the comment about reader-function--std and writer-function--sdt.
  78. ;;;;
  79. ;(define-function-template reader-function--fsc () '(slot-name)
  80. ;  `(function
  81. ;     (lambda (instance)
  82. ;       (slot-value-using-class (wrapper-class (get-wrapper instance))
  83. ;                   instance
  84. ;                   slot-name))))
  85. ;
  86. ;(define-function-template writer-function--fsc () '(slot-name)
  87. ;  `(function
  88. ;     (lambda (nv instance)
  89. ;       (setf
  90. ;     (slot-value-using-class (wrapper-class (get-wrapper instance))
  91. ;                 instance
  92. ;                 slot-name)
  93. ;     nv))))
  94. ;
  95. ;(eval-when (load)
  96. ;  (pre-make-templated-function-constructor reader-function--fsc)
  97. ;  (pre-make-templated-function-constructor writer-function--fsc))
  98.  
  99.  
  100.  
  101.